﻿module JsParser

open FParsec
open System.Text.RegularExpressions
open JsAst

let preProcess str =     
    let str = Regex.Replace(str, "/\*.*?\*/", " ", RegexOptions.IgnorePatternWhitespace)
    let str = Regex.Replace(str, "//.*?$", " ", RegexOptions.Multiline ||| RegexOptions.IgnorePatternWhitespace)
    str.Trim()


(*
    Parser
*)
type UserState = unit // doesn't have to be unit, of course
type Parser<'t> = Parser<'t, UserState>
let ws = spaces

(* tokens *)

let identifier =
    let isIdentifierFirstChar c = isLetter c || c = '$' || c = '_'
    let isIdentifierChar c = isLetter c || isDigit c || c = '$' || c = '_'
    many1Satisfy2L isIdentifierFirstChar isIdentifierChar "identifier" .>> ws


let keyword str = pstring str .>> ws

let symbol str = pstring str .>> ws

let stringLiteralToken : Parser<string> =
    let normalChar = satisfy (fun c -> c <> '\\' && c <> '"')
    let unescape c = match c with
                     | 'n' -> '\n'
                     | 'r' -> '\r'
                     | 't' -> '\t'
                     | c   -> c
    let escapedChar = pstring "\\" >>. (anyOf "\\nrt\"" |>> unescape)
    between (pstring "\"") (pstring "\"")
            (manyChars (normalChar <|> escapedChar)) .>> ws

let numberLiteral : Parser<Expression> = pfloat .>> ws |>> NumberLiteral

(* expressions *)
(* temporary artefacts *)
type Operator = 
    | DotOperator of string
    | CallOperator of Expression list
    | BracketsOperator of Expression

let applyOperator left operator =
    match operator with
    | DotOperator(name) -> PropertyExpression(left, name)
    | CallOperator(args) -> CallExpression(left, args)
    | BracketsOperator(args) -> BracketsExpression(left, args)

let nameReference = identifier |>> Name
let stringLiteral = stringLiteralToken |>> StringLiteral


let expression, expressionImpl = createParserForwardedToRef()

let arguments = sepBy expression (symbol ",")
let callOperator = between (symbol "(") (symbol ")")  arguments |>> CallOperator
let bracketsOperator =  between (symbol "[") (symbol "]")  expression |>> BracketsOperator
let dotOperator = symbol "." >>. identifier |>> DotOperator
let memberOperator = dotOperator <|> bracketsOperator
let callOrMemberOperator = memberOperator <|> callOperator

let statements, statementsImpl = createParserForwardedToRef()

let parameters = sepBy identifier (symbol ",")
let functionExpression = 
    pipe2 
        (keyword "function" >>. (between (symbol "(") (symbol ")")  parameters))
        (between (symbol "{") (symbol "}") statements)
        (fun a b -> FunctionExpression(a,b))
        
let nullLit = keyword "null" |>> fun x->NullLiteral
let boolLiteral = keyword "true" <|> keyword "false" |>> fun v->BooleanLiteral(v="true")

let simpleExpression = functionExpression <|> stringLiteral <|> numberLiteral <|> nullLit <|> boolLiteral  <|> nameReference 

let oppa = new OperatorPrecedenceParser<Expression, unit, unit>()
expressionImpl := oppa.ExpressionParser

let rec applyOps leftExpr ops =
    match ops with
    | [] -> leftExpr
    | (op::rest) -> applyOps (applyOperator leftExpr op) rest

let memberExpression = pipe2 simpleExpression (many memberOperator) (fun ex ops -> applyOps ex ops)
let simpleOrCall = pipe2 simpleExpression (many callOrMemberOperator) (fun ex ops -> applyOps ex ops)

let newExpression = pipe2 (keyword "new" >>. memberExpression) (opt callOperator)
                        (fun expr args -> 
                            match args with
                            | Some(CallOperator(args)) -> NewExpression(expr, args)
                            | None -> NewExpression(expr, []))

let simpleOrNew = newExpression <|> simpleOrCall

do oppa.TermParser <- simpleOrNew <|> between (symbol "(") (symbol ")") expression

// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Operator_Precedence

do oppa.AddOperator(PostfixOperator("--", ws, 17, true, fun x -> PostfixMutate("--", x)))
do oppa.AddOperator(PostfixOperator("++", ws, 17, true, fun x -> PostfixMutate("++", x)))
do oppa.AddOperator(PrefixOperator("!", ws, 16, true, fun x -> UnaryOperation("!", x)))
do oppa.AddOperator(PrefixOperator("~", ws, 16, true, fun x -> UnaryOperation("~", x)))
do oppa.AddOperator(PrefixOperator("+", ws, 16, true, fun x -> UnaryOperation("+", x)))
do oppa.AddOperator(PrefixOperator("-", ws, 16, true, fun x -> UnaryOperation("-", x)))
do oppa.AddOperator(PrefixOperator("--", ws, 16, true, fun x -> PrefixMutate("--", x)))
do oppa.AddOperator(PrefixOperator("++", ws, 16, true, fun x -> PrefixMutate("++", x)))
do oppa.AddOperator(PrefixOperator("typeof", ws, 16, true, fun x -> UnaryOperation("typeof", x)))
do oppa.AddOperator(PrefixOperator("void", ws, 16, true, fun x -> UnaryOperation("void", x)))
do oppa.AddOperator(PrefixOperator("delete", ws, 16, true, fun x -> UnaryOperation("delete", x)))

do oppa.AddOperator(InfixOperator("*", ws, 15, Associativity.Left, fun x y -> BinaryOperation("*", x, y)))
do oppa.AddOperator(InfixOperator("/", ws, 15, Associativity.Left, fun x y -> BinaryOperation("/", x, y)))
do oppa.AddOperator(InfixOperator("%", ws, 15, Associativity.Left, fun x y -> BinaryOperation("%", x, y)))
do oppa.AddOperator(InfixOperator("+", ws, 14, Associativity.Left, fun x y -> BinaryOperation("+", x, y)))
do oppa.AddOperator(InfixOperator("-", ws, 14, Associativity.Left, fun x y -> BinaryOperation("-", x, y)))
do oppa.AddOperator(InfixOperator(">>", ws, 13, Associativity.Left, fun x y -> BinaryOperation(">>", x, y)))
do oppa.AddOperator(InfixOperator("<<", ws, 13, Associativity.Left, fun x y -> BinaryOperation("<<", x, y)))
do oppa.AddOperator(InfixOperator(">>>", ws, 13, Associativity.Left, fun x y -> BinaryOperation(">>>", x, y)))

do oppa.AddOperator(InfixOperator("<", ws, 12, Associativity.Left, fun x y -> BinaryOperation("<", x, y)))
do oppa.AddOperator(InfixOperator("<=", ws, 12, Associativity.Left, fun x y -> BinaryOperation("<=", x, y)))
do oppa.AddOperator(InfixOperator(">", ws, 12, Associativity.Left, fun x y -> BinaryOperation(">", x, y)))
do oppa.AddOperator(InfixOperator(">=", ws, 12, Associativity.Left, fun x y -> BinaryOperation(">=", x, y)))
do oppa.AddOperator(InfixOperator("in", ws, 12, Associativity.Left, fun x y -> BinaryOperation("in", x, y)))
do oppa.AddOperator(InfixOperator("instanceof", ws, 12, Associativity.Left, fun x y -> BinaryOperation("instanceof", x, y)))

do oppa.AddOperator(InfixOperator("==", ws, 11, Associativity.Left, fun x y -> BinaryOperation("==", x, y)))
do oppa.AddOperator(InfixOperator("!=", ws, 11, Associativity.Left, fun x y -> BinaryOperation("!=", x, y)))
do oppa.AddOperator(InfixOperator("===", ws, 11, Associativity.Left, fun x y -> BinaryOperation("===", x, y)))
do oppa.AddOperator(InfixOperator("!==", ws, 11, Associativity.Left, fun x y -> BinaryOperation("!=", x, y)))

do oppa.AddOperator(InfixOperator("&", ws, 10, Associativity.Left, fun x y -> BinaryOperation("&", x, y)))
do oppa.AddOperator(InfixOperator("^", ws, 11, Associativity.Left, fun x y -> BinaryOperation("^", x, y)))
do oppa.AddOperator(InfixOperator("|", ws, 12, Associativity.Left, fun x y -> BinaryOperation("|", x, y)))

do oppa.AddOperator(InfixOperator("&&", ws, 7, Associativity.Left, fun x y -> BinaryOperation("&&", x, y)))
do oppa.AddOperator(InfixOperator("||", ws, 6, Associativity.Left, fun x y -> BinaryOperation("||", x, y)))

do oppa.AddOperator(TernaryOperator("?", ws, ":", ws, 5, Associativity.Left, fun a b c -> ConditionalOperation(a, b, c)))

do oppa.AddOperator(InfixOperator("=", ws, 4, Associativity.Left, fun x y -> AssignmentExpression(x, y)))
do oppa.AddOperator(InfixOperator("+=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("+", x, y)))
do oppa.AddOperator(InfixOperator("-=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("-", x, y)))
do oppa.AddOperator(InfixOperator("*=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("*", x, y)))
do oppa.AddOperator(InfixOperator("/=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("/", x, y)))
do oppa.AddOperator(InfixOperator("%=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("%", x, y)))
do oppa.AddOperator(InfixOperator("<<=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("<<", x, y)))
do oppa.AddOperator(InfixOperator(">>=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression(">>", x, y)))
do oppa.AddOperator(InfixOperator(">>>=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression(">>>", x, y)))
do oppa.AddOperator(InfixOperator("&=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("&", x, y)))
do oppa.AddOperator(InfixOperator("^=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("^", x, y)))
do oppa.AddOperator(InfixOperator("|=", ws, 4, Associativity.Left, fun x y -> CompoundAssignmentExpression("|", x, y)))

// problem: Parameter seperators are parsed as comma
//do oppa.AddOperator(InfixOperator(",", ws, 1, Associativity.Left, fun x y -> BinaryOperation(",", x, y)))

(* statements *)

let variableDeclaration = pipe2 identifier (opt (symbol "=" >>. expression)) (fun id expr -> (id, expr))

let returnStatement = keyword "return" >>. (opt expression) |>> ReturnStatement    
let variableStatement = keyword "var" >>. (sepBy variableDeclaration (symbol ",")) |>> VariableStatement
let functionDeclaration = 
    pipe3 
        (keyword "function" >>. identifier)
        (between (symbol "(") (symbol ")")  parameters)
        (between (symbol "{") (symbol "}") statements)
        (fun name prms body -> FunctionDeclaration(name, prms, body))

let ifStatement = pipe3
                    (keyword "if" >>. (between (symbol "(") (symbol ")") expression))
                    statements
                    (opt ((keyword "else") >>. statements))
                    (fun cond stmts optStmts2 ->
                        match optStmts2 with
                        | Some stmts2 -> IfElseStatement(cond, stmts, stmts2)
                        | None -> IfStatement(cond, stmts))
let expressionStatement = expression |>> ExpressionStatement

let statement = variableStatement <|> returnStatement <|> ifStatement <|> functionDeclaration <|> expressionStatement
do statementsImpl := sepEndBy statement (symbol ";")

let parseJs src = run statements (preProcess src)
